home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCROLL.SWG / 0009_Sinus Scroll.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  2KB  |  81 lines
  1. {
  2. > but you can use Pascal to do things like this:
  3. }
  4. program SinusScroll;
  5. const
  6.   GSeg = $a000;
  7.   Sofs = 140; Samp = 40; Slen = 255;
  8.   Size = 2; Curve = 3;
  9.   Xmax = 279 div Size; Ymax = 7;
  10.   ScrSpd = -1;
  11.   ScrText : string =
  12.     ' Hai world... This looks a bit like the scroll of the second part'+
  13.     ' of Future Crew''s Unreal demo (part one)...     It''s not filled'+
  14.     ' but it sure looks nicer (imho)...                               ';
  15. type SinArray = array[0..Slen] of word;
  16. var Stab : SinArray; Fseg,Fofs : word;
  17.  
  18. procedure CalcSinus; var I : word; begin
  19.   for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;
  20.  
  21. procedure GetFont; assembler; asm
  22.   mov ax,1130h; mov bh,1; int 10h; mov Fseg,es; mov Fofs,bp; end;
  23.  
  24. procedure SetGraphics(Mode : word); assembler; asm
  25.   mov ax,Mode; int 10h end;
  26.  
  27. function keypressed : boolean; assembler; asm
  28.   mov ah,0bh; int 21h; and al,0feh; end;
  29.  
  30. procedure Scroll;
  31. type
  32.   ScrArray = array[0..Xmax,0..Ymax] of byte;
  33.   PosArray = array[0..Xmax,0..Ymax] of word;
  34. var
  35.   PosTab : PosArray;
  36.   BitMap : ScrArray;
  37.   X,I,SinIdx : word;
  38.   Y,ScrIdx,CurChar : byte;
  39. begin
  40.   fillchar(BitMap,sizeof(BitMap),0);
  41.   fillchar(PosTab,sizeof(PosTab),0);
  42.   ScrIdx := 1; SinIdx := 0;
  43.   repeat
  44.     Curchar := ord(ScrText[ScrIdx]);
  45.     inc(ScrIdx); if ScrIdx = length(ScrText) then ScrIdx := 1;
  46.     for I := 0 to 7 do begin
  47.       move(BitMap[1,0],BitMap[0,0],(Ymax+1)*Xmax);
  48.       for Y := 0 to Ymax do
  49.         if ((mem[Fseg:Fofs+8*CurChar+Y] shl I) and 128) <> 0 then
  50.           BitMap[Xmax,Y] := ((ScrIdx+Y-I) mod 70)+32 else BitMap[Xmax,Y] := 0;
  51.       while (port[$3da] and 8) <> 0 do;
  52.       while (port[$3da] and 8) = 0 do;
  53.       for X := 0 to Xmax do
  54.         for Y := 0 to Ymax do begin
  55.           mem[GSeg:PosTab[X,Y]] := 0;
  56.           PosTab[X,Y] := (Size*Y+STab[(SinIdx+X+Curve*Y) mod
  57.                       SLen])*320+Size*X+STab[(X+Y) mod SLen]-SOfs;
  58.           mem[GSeg:PosTab[X,Y]] := BitMap[X,Y];
  59.         end;
  60.       SinIdx := (SinIdx+ScrSpd) mod SLen;
  61.     end;
  62.   until keypressed;
  63. end;
  64.  
  65. begin
  66.   CalcSinus;
  67.   GetFont;
  68.   SetGraphics($13);
  69.   Scroll;
  70.   SetGraphics(3);
  71. end.
  72.  
  73. { --- and again --- }
  74.  
  75. The prior 'release' was a bit buggy indeed (as I expected). So here's a
  76. better working version. It's smaller too. Not only thanx to the
  77. variable-size. Have fun!
  78.  
  79. Btw: 'keypressed' was taken from Sean Palmers' GhostEd. The rest, of course,
  80. by me! ;-)
  81.